Policy Exploration
Janette Avelar
2024-06-13
#manual branding - file won't load
transcend_cols = c("#1A4C81","#59C3B4","#EF464B","#ADE0EE")
transcend_cols2 = c("#BC2582","#FFA630","#FFDE42","#99C24D","#218380","#D3B7D7")
transcend_grays = c("#4D4D4F","#9D9FA2","#D1D3D4")
transcend_na = transcend_grays[2]
theme_transcend = theme_gdocs(base_size = 14, base_family = "Open Sans") +
theme(
plot.title = element_text(family = "Bebas Neue", color = "black"),
plot.background = element_blank(),
axis.text = element_text(colour = "black"),
axis.title = element_text(colour = "black"),
panel.border = element_rect(colour = "#4D4D4F"),
strip.text = element_text(size = rel(0.8)),
plot.margin = margin(10, 24, 10, 10, "pt")
)
theme_set(theme_transcend)Guiding Question: What are the policies and ecosystem factors shaping innovation?
Initial exploration
#policy labels
policy_labs <- variables %>%
select(starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
select(policy) %>%
unique() %>%
mutate(label = case_when(
policy == "policy_public_revenue" ~ "Availability of public revenue",
policy == "policy_philanthropy" ~ "Availability of philanthropic funding",
policy == "policy_schedule" ~ "Calendar and schedule requirements",
policy == "policy_graduation" ~ "Course progression, seat time, and graduation requirements",
policy == "policy_admissions" ~ "Admission requirements for college, high school, or middle school",
policy == "policy_accountability" ~ "Accountability systems imposed by states, districts, or authorizers",
policy == "policy_report_funders" ~ "Accountability or reporting expectations from philanthropic funders",
policy == "policy_service" ~ "Interactions with public service providers",
policy == "policy_credentials" ~ "Teacher/staff credentialing or evaluation requirements",
policy == "policy_union" ~ "Labor contracts and/or union relationships",
policy == "policy_enrollment" ~ "Enrollment, lottery, or school assignment systems"
),
short_label = case_when(
policy == "policy_public_revenue" ~ "Public revenue",
policy == "policy_philanthropy" ~ "Philanthropic funding",
policy == "policy_schedule" ~ "Calendar/scheduling requirements",
policy == "policy_graduation" ~ "Course progression, seat time, and graduation",
policy == "policy_admissions" ~ "Admission requirements",
policy == "policy_accountability" ~ "Accountability systems",
policy == "policy_report_funders" ~ "Expectations from philanthropic funders",
policy == "policy_service" ~ "Public service providers",
policy == "policy_credentials" ~ "Credentialing/evaluation",
policy == "policy_union" ~ "Labor contracts and/or union relationships",
policy == "policy_enrollment" ~ "Enrollment, lottery, or school assignment"
),
n_label = case_when(
policy == "policy_public_revenue" ~ "Public revenue (N = 156)",
policy == "policy_philanthropy" ~ "Philanthropic funding (N = 146)",
policy == "policy_schedule" ~ "Calendar/scheduling requirements (N = 143)",
policy == "policy_graduation" ~ "Course progression, seat time, and graduation (N = 131)",
policy == "policy_admissions" ~ "Admission requirements (N = 104)",
policy == "policy_accountability" ~ "Accountability systems (N = 148)",
policy == "policy_report_funders" ~ "Expectations from philanthropic funders (N = 78)",
policy == "policy_service" ~ "Public service providers (N = 143)",
policy == "policy_credentials" ~ "Credentialing/evaluation (N = 121)",
policy == "policy_union" ~ "Labor contracts and/or union relationships (N = 67)",
policy == "policy_enrollment" ~ "Enrollment, lottery, or school assignment (N = 79)"
)) %>%
filter(!is.na(label))Raw counts:
The distribution for a couple of these reported policies and ecosystem factors are interesting to note:
Availability of philanthropic funding has a clear curve upward with few schools saying it hinders their work, and many more schools reporting it somewhat or really helps their work. Unlike other factors, most schools reported that it “really helps.”
Availability of public revenue also had an odd pattern, with many school leaders reporting that it really hinders, really helps, and both hinders and helps their innovation work.
Labor contracts and/or union relationships skewed more negatively, with most schools responding they both helped and hindered innovation work (N = 29) and an equal number reporting they hindered innovation work (N = 28). This factor is also interesting because fewer schools responded to it. While other factors had between ~140-170 responses, labor/union only had 116 responses total, and 49 of these are not represented in the figure because schools reported they have “no effect.”
variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1,
response = factor(response, levels = c("Really helps", "Somewhat helps", "Both helps and hinders", "Somewhat hinders", "Really hinders"))) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
filter(!is.na(response)) %>%
group_by(policy) %>%
mutate(total = sum(n)) %>%
left_join(policy_labs, by = "policy") %>%
filter(policy != "support", policy != "No effect") %>%
ggplot(., aes(response, n)) +
geom_col(fill = transcend_cols[1]) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
axis.text.y = element_text(size = 11)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 65)) +
geom_text(aes(label = n), nudge_y = 0.5, hjust = 0, color = transcend_na, fontface = "bold", size = 5.5, family = "sans") +
coord_flip() +
facet_wrap(~n_label, labeller = label_wrap_gen(width = 20)) +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors affect \nyour innovation work?")
Alternate percentage graph:
variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1,
response = factor(response, levels = c("Really helps", "Somewhat helps", "Both helps and hinders", "Somewhat hinders", "Really hinders"))) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
filter(!is.na(response)) %>%
group_by(policy) %>%
mutate(total = sum(n),
pct = n/total) %>%
left_join(policy_labs, by = "policy") %>%
filter(policy != "support", policy != "No effect") %>%
ggplot(., aes(response, pct)) +
geom_col(fill = transcend_cols[1]) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
axis.text.y = element_text(size = 11)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, .75), labels = scales::percent_format()) +
geom_text(aes(label = scales::label_percent(accuracy = 1)(pct)), nudge_y = 0.01, hjust = 0, color = transcend_na, fontface = "bold", size = 5, family = "sans") +
coord_flip() +
facet_wrap(~short_label, labeller = label_wrap_gen(width = 20)) +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors affect \nyour innovation work?")
Here’s an overall table view of the number of schools responding and how they are responding (collapsed into helps/hinders).
variables %>%
select(school_id, starts_with("policy"), -policy_support) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1,
response = case_when(
response == "Really helps" ~ "Helps",
response == "Somewhat helps" ~ "Helps",
response == "Both helps and hinders" ~ "Both",
response == "No effect" ~ "No effect",
response == "Somewhat hinders" ~ "Hinders",
response == "Really hinders" ~ "Hinders"
)) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
filter(!is.na(response)) %>%
group_by(policy) %>%
mutate(total = sum(n)) %>%
ungroup() %>%
pivot_wider(names_from = response,
values_from = n) %>%
left_join(policy_labs, by = "policy") %>%
select(`Policy or Ecosystem Factor` = label, `Schools responding` = total, Helps, Hinders, Both, `No effect`) %>%
unique() %>%
datatable()The figure above is kind of a lot to take in at once, so I next explored which policies/ecosystem factors are helping?
By far, the availability of philanthropic funds are what schools report is helping support innovation work the most, followed by availability of public revenue. This isn’t terribly surprising, as financial support is necessary to maintain innovation work. More surprising is that interactions with public service providers (e.g., social services, law enforcement, etc.) was in the top 3 reported ecosystem factors supporting innovation work.
helps <- variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
left_join(policy_labs, by = "policy") %>%
filter(response == "Really helps" | response == "Somewhat helps") %>%
mutate(response = factor(response, levels = c("Somewhat helps", "Really helps")))
#plot
ggplot(helps, aes(reorder(short_label, n), n, fill = response)) +
geom_col() +
scale_fill_manual(values = transcend_cols, breaks = c("Really helps", "Somewhat helps")) +
theme(legend.position = "top",
legend.direction = "horizontal",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
scale_y_continuous(expand = c(0, 0)) +
scale_x_discrete(labels = wrap_format(25)) +
geom_text(aes(label = n, y = n), position = position_stack(vjust = 1), hjust = 1.65, color = "white", size = 5.5, family = "sans") +
coord_flip() +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors \naffect your innovation work?",
fill = "Response")
Below is the same plot, with the percentage of schools reporting, rather than raw counts.
variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
filter(!is.na(response)) %>%
group_by(policy) %>%
mutate(total = sum(n)) %>%
ungroup() %>%
mutate(pct = n/total) %>%
left_join(policy_labs, by = "policy") %>%
filter(response == "Really helps" | response == "Somewhat helps") %>%
mutate(response = factor(response, levels = c("Somewhat helps", "Really helps"))) %>%
ggplot(., aes(reorder(short_label, pct), pct, fill = response)) +
geom_col() +
scale_fill_manual(values = transcend_cols, breaks = c("Really helps", "Somewhat helps")) +
theme(legend.position = "top",
legend.direction = "horizontal",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, .7), labels = scales::percent_format()) +
scale_x_discrete(labels = wrap_format(25)) +
geom_text(aes(label = scales::label_percent(accuracy = 1)(pct), y = pct),
position = position_stack(vjust = .95),
hjust = 1,
color = "white",
size = 4,
family = "sans") +
coord_flip() +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors \naffect your innovation work?",
fill = "Response")
Which policies/ecosystem factors are hindering innovation work?
Accountability systems most hindered innovation work for these school leaders, followed by policies that establish requirements for schools to follow, including course progression/seat time/graduation, credentialing/evaluation of teachers, calendar/scheduling requirements, and admission requirements. The extent to which they hindered work seems to differ across factors, but generally around a quarter or more of schools that responded said these type of requirements at least somewhat hinder innovation work.
hinders <- variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
left_join(policy_labs, by = "policy") %>%
filter(response == "Really hinders" | response == "Somewhat hinders") %>%
mutate(response = factor(response, levels = c("Somewhat hinders", "Really hinders")))
#plot
ggplot(hinders, aes(reorder(short_label, n), n, fill = response)) +
geom_col() +
scale_fill_manual(values = c(transcend_cols[3], transcend_cols2[2]), breaks = c("Really hinders", "Somewhat hinders")) +
theme(legend.position = "top",
legend.direction = "horizontal",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
scale_y_continuous(expand = c(0, 0)) +
scale_x_discrete(labels = wrap_format(25)) +
geom_text(aes(label = n, y = n), position = position_stack(vjust = 1), hjust = 1.65, color = "white", size = 5.5, family = "sans") +
coord_flip() +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors \naffect your innovation work?",
fill = "Response")
Below is the same plot, with the percentage of schools reporting, rather than raw counts.
variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
filter(!is.na(response)) %>%
group_by(policy) %>%
mutate(total = sum(n)) %>%
ungroup() %>%
mutate(pct = n/total) %>%
left_join(policy_labs, by = "policy") %>%
filter(response == "Really hinders" | response == "Somewhat hinders") %>%
mutate(response = factor(response, levels = c("Somewhat hinders", "Really hinders"))) %>%
ggplot(., aes(reorder(short_label, pct), pct, fill = response)) +
geom_col() +
scale_fill_manual(values = c(transcend_cols[3], transcend_cols2[2]), breaks = c("Really hinders", "Somewhat hinders")) +
theme(legend.position = "top",
legend.direction = "horizontal",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, .6), labels = scales::percent_format()) +
scale_x_discrete(labels = wrap_format(25)) +
geom_text(aes(label = scales::label_percent(accuracy = 1)(pct)),
position = position_stack(vjust = .95),
hjust = 1,
color = "white",
size = 5,
family = "sans") +
coord_flip() +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors \naffect your innovation work?",
fill = "Response")
Combined helps/hinders plot:
combined_factors <- bind_rows(helps, hinders) %>%
mutate(n = ifelse(response == "Really hinders" | response == "Somewhat hinders", n*-1, n*1),
response = factor(response, levels = c("Really hinders", "Somewhat hinders", "Really helps", "Somewhat helps")))
ggplot(combined_factors, aes(n, reorder(short_label, n), fill = response)) +
geom_col() +
scale_fill_manual(values = c(
"Really hinders" = transcend_cols[3],
"Somewhat hinders" = transcend_cols2[2],
"Somewhat helps" = transcend_cols[2],
"Really helps" = transcend_cols[1])) +
theme(legend.position = "top",
legend.direction = "horizontal",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
# guides(fill = guide_legend(override.aes =
# list(fill = c(transcend_cols[3], transcend_cols2[2], transcend_cols[2], transcend_cols[1])))) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_discrete(labels = wrap_format(25)) +
geom_text(aes(label = abs(n), x = n), position = position_stack(vjust = 1), hjust = 1.2, color = "white", size = 5.5, family = "sans") +
labs(x = "Number of schools",
y = "",
title = "How do existing policies and ecosystem factors affect Canopy schools' work?",
fill = "Response")
Which policies/ecosystem factors are not having an effect?
We gave school leaders the option to select “No effect” for any ecosystem policies/factors on the list. A third of respondents reported expectations from philanthropic funders did not effect their innovation work, while roughly a quarter reported enrollment, lottery, or school assignment policies, admission requirements, labor contracts/unions, and interactions with public service providers had no effect on their innovation work. On the other hand, funding and accountability were much less often reported as having no effect, which seems to be aligned with the findings above that these two areas were ones leaders heavily reported as helping or hindering innovation work to a greater extent.
variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
left_join(policy_labs, by = "policy") %>%
filter(response == "No effect") %>%
ggplot(., aes(reorder(short_label, n), n, fill = response)) +
geom_col() +
scale_fill_manual(values = c(transcend_cols[4])) +
theme(legend.position = "none",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 75)) +
scale_x_discrete(labels = wrap_format(25)) +
geom_text(aes(label = n), nudge_y = 0.5, hjust = 0, color = transcend_na, fontface = "bold", size = 5.5, family = "sans") +
coord_flip() +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors \naffect your innovation work?",
fill = "Response")
variables %>%
select(school_id, starts_with("policy")) %>%
pivot_longer(cols = starts_with("policy"),
names_to = "policy",
values_to = "response") %>%
mutate(rate = 1) %>%
group_by(policy, response) %>%
summarize(n = sum(rate)) %>%
ungroup() %>%
group_by(policy) %>%
mutate(total = sum(n)) %>%
ungroup() %>%
mutate(pct = n/total) %>%
left_join(policy_labs, by = "policy") %>%
filter(response == "No effect") %>%
ggplot(., aes(reorder(short_label, pct), pct, fill = response)) +
geom_col() +
scale_fill_manual(values = c(transcend_cols[4])) +
theme(legend.position = "none",
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size = 13)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1), labels = scales::percent_format()) +
scale_x_discrete(labels = wrap_format(25)) +
geom_text(aes(label = scales::label_percent(accuracy = 1)(pct)), hjust = 0, color = transcend_na, fontface = "bold", size = 5.5, family = "sans") +
coord_flip() +
labs(x = "",
y = "",
title = "How do existing policies and ecosystem factors \naffect your innovation work?",
fill = "Response")
Modeling
Logistic Regression Models
I ran a series of regression models below to explore the school characteristics that helped explain which factors or policies helped innovation work. In order to do so, I converted each policy/factor into a binary variable with a positive value (somewhat/really helps) set to 1. Thus, the output can be read as the likelihood for schools to report a policy helping their work.
I have not worked with ordinal outcome variables very much so I wasn’t sure if an ordinal regression model would be a better fit and was not entirely sure how to set up the data or fit the model for that purpose. For instance, should we include a factor for Hinders -> No effect -> Helps? I’m open to suggestions here.
# create version with dummy outcomes
mod_dat <- variables %>%
select(school_id, starts_with("policy"), -policy_support, school_locale, school_type, grades_pk, grades_elementary, grades_middle, grades_high, school_enrollment, pct_bipoc, pct_ell, pct_frpl, pct_swd, teaching_diversity, leadership_diversity) %>%
mutate(across(starts_with("policy"), ~case_when(
. == "Really helps" ~ 1,
. == "Somewhat helps" ~ 1,
is.na(.) ~ NA,
TRUE ~ 0
)))
# model function
log_model <- function(outcome, title){ #outcome needs to be dummy
#prep data
data <- mod_dat %>%
mutate(teaching_diversity = gsub("people", "teachers", teaching_diversity),
leadership_diversity = gsub("people", "leaders", leadership_diversity),
school_locale = factor(school_locale, levels = c("Urban", "Suburban", "Rural", "Multiple")),
school_type = factor(school_type, levels = c("Public district school", "Public charter school", "Independent (private) school")),
teaching_diversity = factor(teaching_diversity, levels = c("0 - 24% teachers of color", "25 - 49% teachers of color", "50 - 74% teachers of color", "75 - 100% teachers of color")),
leadership_diversity = factor(leadership_diversity, levels = c("0 - 24% leaders of color", "25 - 49% leaders of color", "50 - 74% leaders of color", "75 - 100% leaders of color")),
school_enrollment = as.numeric(scale(school_enrollment, center = TRUE, scale = TRUE))) %>%
mutate(across(starts_with("pct"), ~as.numeric(scale(., center = TRUE, scale = TRUE))))
# set labels
cov_labels <- c(
"school_typeIndependent (private) school" = "Independent (private) school",
"school_typePublic charter school" = "Public charter school",
"grades_pk" = "PreK",
"grades_elementary" = "Elementary",
"grades_middle" = "Middle",
"grades_high" = "High",
"school_enrollment" = "School Enrollment",
"pct_bipoc" = "% BIPOC students",
"pct_ell" = "% EL-designated students",
"pct_frpl" = "% FRPL-eligible",
"pct_swd" = "% Students with disabilities",
"school_localeMultiple" = "Multiple locales",
"school_localeSuburban" = "Suburban",
"school_localeRural" = "Rural",
"leadership_diversity25 - 49% leaders of color" = "25-49% leaders of color",
"leadership_diversity50 - 74% leaders of color" = "50-74% leaders of color",
"leadership_diversity75 - 100% leaders of color" = "75-100% leaders of color",
"teaching_diversity25 - 49% teachers of color" = "25-49% teachers of color",
"teaching_diversity50 - 74% teachers of color" = "50-74% teachers of color",
"teaching_diversity75 - 100% teachers of color" = "75-100% teachers of color"
)
#model
mod <- glm({{outcome}} ~ school_locale + school_type + grades_pk + grades_elementary + grades_middle + grades_high + school_enrollment + pct_bipoc + pct_ell + pct_frpl + pct_swd + teaching_diversity + leadership_diversity,
family = "binomial",
data = data)
#plot
plot <- tidy(mod, effects = "ran_pars", conf.int = TRUE) %>%
filter(term != "(Intercept)") %>%
mutate(exp_est = exp(estimate),
exp_min = exp(estimate - std.error),
exp_max = exp(estimate + std.error)) %>%
mutate(term = cov_labels[term]) %>%
ggplot(., aes(y = fct_reorder(term, exp_est), x = exp_est)) +
geom_linerange(aes(xmin = exp_min,
xmax = exp_max),
color = "blue") +
geom_point() +
geom_vline(xintercept = 1) +
scale_x_continuous(
trans = "log",
breaks = c(.0625, .25, .5, 1, 2, 4, 16),
labels = str_wrap(c("1/16 as likely", "1/4 as likely", "1/2 as likely", "Even", "2x as likely", "4x as likely", "16x as likely"), 10),
expand = expansion(0, 0)
) +
theme_transcend +
theme(panel.grid.major.y = element_blank()) +
labs(
x = "",
y = "",
title = str_wrap(title, 60))
return(plot)}Availability of public revenue
log_model(mod_dat$policy_public_revenue, "School characteristics predicting reporting public revenue as helpful")
Availability of philanthropic funding
log_model(mod_dat$policy_philanthropy, "School characteristics predicting reporting philanthropic funds as helpful")
Calendar and schedule requirements
log_model(mod_dat$policy_schedule, "School characteristics predicting reporting calendar/scheduling requirements as helpful")
Course progression, seat time, and graduation requirements
suppressWarnings(
log_model(mod_dat$policy_graduation, "School characteristics predicting reporting course progression, seat time, and graduation requirements as helpful")
)## Warning: Transformation introduced infinite values in continuous x-axis
Admission requirements for college, high school, or middle school
Model output was very strange for this factor and a few below. Predicted likelihood was super small. Wondering if we would see something different if we ran models predicting hindering innovation work, rather than helping innovation work? Or maybe this is one area where running a binomial model rather than an ordinal model introduces issues.
suppressWarnings(
log_model(mod_dat$policy_graduation, "School characteristics predicting reporting admission requirements as helpful")
)## Warning: Transformation introduced infinite values in continuous x-axis
Accountability systems (including tests) imposed by states, districts, or authorizers
suppressWarnings(
log_model(mod_dat$policy_accountability, "School characteristics predicting reporting accountability systems as helpful")
)## Warning: Transformation introduced infinite values in continuous x-axis
Accountability or reporting expectations from philanthropic funders
log_model(mod_dat$policy_philanthropy, "School characteristics predicting reporting expectations from philanthropic funders as helpful")
Interactions with public service providers (e.g., social services, law enforcement, etc.)
log_model(mod_dat$policy_service, "School characteristics predicting reporting interactions with public service providers as helpful")
Teacher/staff credentialing or evaluation requirements
log_model(mod_dat$policy_credentials, "School characteristics predicting reporting credentialing and evaluation requirements as helpful")
Labor contracts and/or union relationships
I’m not too surprised that this one turned out looking very strange because the sample was so small. It also threw warnings for this model.
suppressWarnings(
log_model(mod_dat$policy_union, "School characteristics predicting reporting labor contracts and/or union relationships as helpful")
)## Warning: Transformation introduced infinite values in continuous x-axis
Enrollment, lottery, or school assignment systems
suppressWarnings(
log_model(mod_dat$policy_enrollment, "School characteristics predicting reporting enrollment, lottery, or school assignment systems as helpful")
)
Linear Regression Models
Per Gregor’s suggestion, in the following models I have changed the value of the outcome variable to a centered value between -2 and 2. I’m treating “No effect” and “Both helps and hinders” as the central value (0), indicating the policy has no effect. I’m a little confused on the interpretation, mainly because I was surprised to see no negative coefficients when running the linear models.
# create version with dummy outcomes
mod_dat <- variables %>%
select(school_id, starts_with("policy"), -policy_support, school_locale, school_type, grades_pk, grades_elementary, grades_middle, grades_high, school_enrollment, pct_bipoc, pct_ell, pct_frpl, pct_swd, teaching_diversity, leadership_diversity) %>%
mutate(across(starts_with("policy"), ~case_when(
. == "Really helps" ~ 5,
. == "Somewhat helps" ~ 4,
. == "No effect" ~ 3,
. == "Both helps and hinders" ~ 3,
. == "Somewhat hinders" ~ 2,
. == "Really hinders" ~ 1,
is.na(.) ~ NA_real_,
TRUE ~ 0
))) %>%
mutate(across(starts_with("policy"), ~{
mapped_value <- (.-3) / 2 # Center around 0 and scale
scaled_value <- mapped_value * 2 # Scale to fall between -2 and 2
return(scaled_value)
}))
# model function
lm_model <- function(outcome, title){ #outcome needs to be dummy
#prep data
data <- mod_dat %>%
mutate(teaching_diversity = gsub("people", "teachers", teaching_diversity),
leadership_diversity = gsub("people", "leaders", leadership_diversity),
school_locale = factor(school_locale, levels = c("Urban", "Suburban", "Rural", "Multiple")),
school_type = factor(school_type, levels = c("Public district school", "Public charter school", "Independent (private) school")),
teaching_diversity = factor(teaching_diversity, levels = c("0 - 24% teachers of color", "25 - 49% teachers of color", "50 - 74% teachers of color", "75 - 100% teachers of color")),
leadership_diversity = factor(leadership_diversity, levels = c("0 - 24% leaders of color", "25 - 49% leaders of color", "50 - 74% leaders of color", "75 - 100% leaders of color")),
school_enrollment = as.numeric(scale(school_enrollment, center = TRUE, scale = TRUE))) %>%
mutate(across(starts_with("pct"), ~as.numeric(scale(., center = TRUE, scale = TRUE))))
# set labels
cov_labels <- c(
"school_typeIndependent (private) school" = "Independent (private) school",
"school_typePublic charter school" = "Public charter school",
"grades_pk" = "PreK",
"grades_elementary" = "Elementary",
"grades_middle" = "Middle",
"grades_high" = "High",
"school_enrollment" = "School Enrollment",
"pct_bipoc" = "% BIPOC students",
"pct_ell" = "% EL-designated students",
"pct_frpl" = "% FRPL-eligible",
"pct_swd" = "% Students with disabilities",
"school_localeMultiple" = "Multiple locales",
"school_localeSuburban" = "Suburban",
"school_localeRural" = "Rural",
"leadership_diversity25 - 49% leaders of color" = "25-49% leaders of color",
"leadership_diversity50 - 74% leaders of color" = "50-74% leaders of color",
"leadership_diversity75 - 100% leaders of color" = "75-100% leaders of color",
"teaching_diversity25 - 49% teachers of color" = "25-49% teachers of color",
"teaching_diversity50 - 74% teachers of color" = "50-74% teachers of color",
"teaching_diversity75 - 100% teachers of color" = "75-100% teachers of color"
)
#model
mod <- lm({{outcome}} ~ school_locale + school_type + grades_pk + grades_elementary + grades_middle + grades_high + school_enrollment + pct_bipoc + pct_ell + pct_frpl + pct_swd + teaching_diversity + leadership_diversity, data = data)
#plot
plot <- tidy(mod, effects = "ran_pars", conf.int = TRUE) %>%
filter(term != "(Intercept)") %>%
mutate(estimate = exp(estimate)) %>%
mutate(term = cov_labels[term]) %>%
ggplot(., aes(y = fct_reorder(term, estimate), x = estimate)) +
geom_linerange(aes(xmin = estimate - std.error,
xmax = estimate + std.error),
color = "blue") +
geom_point() +
geom_vline(xintercept = 0) +
theme_transcend +
theme(panel.grid.major.y = element_blank()) +
labs(
x = "",
y = "",
title = str_wrap(title, 60))
return(plot)}Availability of public revenue
lm_model(mod_dat$policy_public_revenue, "School characteristics predicting whether public revenue helps or hinders innovation work")
Availability of philanthropic funding
lm_model(mod_dat$policy_philanthropy, "School characteristics predicting whether philanthropic funds help or hinder innovation work")
Calendar and schedule requirements
lm_model(mod_dat$policy_schedule, "School characteristics predicting whether calendar/scheduling requirements help or hinder innovation work")
Course progression, seat time, and graduation requirements
lm_model(mod_dat$policy_graduation, "School characteristics predicting whether course progression, seat time, and graduation requirements help or hinder innovation work")
Admission requirements for college, high school, or middle school
lm_model(mod_dat$policy_graduation, "School characteristics predicting whether admission requirements help or hinder innovation work")
Accountability systems (including tests) imposed by states, districts, or authorizers
lm_model(mod_dat$policy_accountability, "School characteristics predicting reporting accountability systems as helpful")
Accountability or reporting expectations from philanthropic funders
lm_model(mod_dat$policy_philanthropy, "School characteristics predicting reporting expectations from philanthropic funders as helpful")
Interactions with public service providers (e.g., social services, law enforcement, etc.)
lm_model(mod_dat$policy_service, "School characteristics predicting reporting interactions with public service providers as helpful")
Teacher/staff credentialing or evaluation requirements
lm_model(mod_dat$policy_credentials, "School characteristics predicting reporting credentialing and evaluation requirements as helpful")
Labor contracts and/or union relationships
lm_model(mod_dat$policy_union, "School characteristics predicting reporting labor contracts and/or union relationships as helpful")
Enrollment, lottery, or school assignment systems
lm_model(mod_dat$policy_enrollment, "School characteristics predicting reporting enrollment, lottery, or school assignment systems as helpful")